Summary

Most recent HH survey date: 2021-04-20
Script run on: 2022-06-16

There were 357 complete submissions of HH questionnaires from 18 implementers on 2021-04-20.

The total number of HH questionnaire submissions since 18/03/2021 is 2761.

A total of 436 People were individual today. The number of people individual overall is now 3790 and we are 8481 away from the target (12,217).

There were 3 diagnoses of LF lymphedema through the HH survey on 2021-04-20, bringing the total number detected since 18/03 to 12.

There were 0 diagnoses of LF hydrocele through the HH survey on 2021-04-20, bringing the total number detected since 18/03 to 8.

Number of confirmed and excluded individual of LF lymphedema and hydrocele, out of all suspected individual, by village (HH survey):

There was/ were 2 Household (HH) form version(s) in use on 2021-04-20

HH_implementer_id formdef_version total_subs
hh_1001 2104181818 31
hh_1002 2104181818 29
hh_1003 2104181818 25
hh_1004 2103211826 20
hh_1005 2103211826 32
hh_1006 2103211826 2
hh_1006 2104181818 22
hh_1007 2104181818 15
hh_1008 2104181818 13
hh_1009 2104181818 15
hh_1010 2104181818 18
hh_1011 2104181818 30
hh_1012 2104181818 7
hh_1013 2104181818 15
hh_1014 2104181818 26
hh_1015 2104181818 22
hh_1016 2104181818 9
hh_1017 2104181818 13
hh_1018 2104181818 13

Phones not recording electronic signatures

There were 0 casses of signatures not working

HH_implementer_id date

People censused and examined by team and implementer

HH_implementer_id total_submissions complete_interviews individual le_suspect hc_suspected
3 hh_1003 201 153 238 1 0
17 hh_1017 175 152 288 1 0
7 hh_1007 160 149 281 2 0
15 hh_1015 214 146 275 1 4
2 hh_1002 150 140 160 0 0
10 hh_1010 154 139 291 4 4
1 hh_1001 167 137 198 0 0
18 hh_1018 184 125 234 2 1
4 hh_1004 166 123 163 1 3
6 hh_1006 143 123 167 0 1
16 hh_1016 142 120 211 1 0
12 hh_1012 129 119 275 0 0
13 hh_1013 162 117 215 0 4
8 hh_1008 125 110 145 0 1
9 hh_1009 128 101 208 0 0
11 hh_1011 125 99 149 2 0
14 hh_1014 123 90 177 0 2
5 hh_1005 113 83 115 1 0

Map 1: Clusters visited most recent survey day

[1] "Date :  2021-04-20"

This shows clusters mapped on the most recent survey day check clusters are not overlapping (HH locations not shown on this map for confidentiality) Check HH locations are within geotraces


Map 2: All Clusters visited

Questionnaires by Implementer (most recent workday only)



Start/ Finish times


Check implementers starting after 10 or starting last interview before 4pm

Duration


Duration of survey by questionnaire type (all questionnaires) Check if any implementers seem to be rushing interviews/ examinations

Refusals- Lymphedema


Refusals- Hydrocele


---
title: "LF Morbidity Survey in Bongouanou, Cote d'Ivoire"
output:
  flexdashboard::flex_dashboard:
    storyboard: true
    social: menu
    source: embed
    css = 

---

```{r setup, include = FALSE, cache = TRUE}
library(dplyr)
library(lubridate)
library(statar)
library(flexdashboard)
library(plotly)
library(cowplot)
library(knitr)
library(stringr)
library(leaflet)
library(sf)
library(hms)
library(mapview)
library(tmap)
library(kableExtra)
library(stargazer)

# Read dataset of household interviews
hh <- read.csv("anonymous_data/survey_household_data.csv")

nrow(hh) # 9415

# filter by date to reduce dataset for the demo
hh <- hh %>%
  filter(date >= as.Date("2021-04-01") & 
         date < as.Date("2021-04-30"))

# how many submissions in total? 
n_subs_hh_all <- nrow(hh)
n_subs_hh_all # 2761

# how many implementers submitted data today?
n_implementers_submitted <- n_distinct(c(hh[hh$date ==  max(hh$date),]$HH_implementer_id))

# How many household interviews were undertaken today?
n_subs_hh <- nrow(hh[hh$date ==  max(hh$date),])

# Read dataset of individual examinations
individual <-  read.csv("anonymous_data/survey_individual_data.csv")
# filter by date to reduce dataset for the demo
individual <- individual %>%
  filter(date >= as.Date("2021-04-01") & 
         date < as.Date("2021-04-30"))

# How many people were examined today?
n_h_hh_exams <- nrow(individual[individual$date==max(individual$date),])

# How many people have been examined in total?
n_individual <- nrow(individual)

# How many do we need to do?
left <- 12271 - n_individual

# How many cases of hydrocele have been found in the survey so far?
n_hc_found <- nrow(individual[!is.na(individual$diagnosis_lf_hydrocoele) & individual$diagnosis_lf_hydrocoele_1==1,])

# How many cases of lymphedema have been found in the survey so far?
n_le_found <-  nrow(individual[!is.na(individual$diagnosis_lymph_1) & individual$diagnosis_lymph_1==1,])

# How many cases of hydrocele were found today?
n_hc_today <- nrow(individual[individual$date== max(individual$date) &  !is.na(individual$diagnosis_lf_hydrocoele) & individual$diagnosis_lf_hydrocoele==1,])

# How many cases of lymphedema were found today?
n_le_today <-  nrow(individual[individual$date== max(individual$date) & !is.na(individual$diagnosis_lymph) & individual$diagnosis_lymph_1==1,])

# How many form versions were in use?
n_defs <- n_distinct(hh[hh$date ==  max(hh$date),]$formdef_version)

# make a table showing the form version and number of complete screens by implementer today
formdefs <- hh %>%   filter(date ==  max(hh$date)) %>%   
  group_by(HH_implementer_id, formdef_version) %>% summarise(total_subs = n())

```

### Summary

Most recent HH survey date: `r max(hh$date)`   
Script run on: `r today()`  

There were `r n_subs_hh` complete submissions of HH questionnaires from `r n_implementers_submitted` implementers on `r max(hh$date)`.

The total number of HH questionnaire submissions since 18/03/2021 is `r n_subs_hh_all`.  

A total of `r n_h_hh_exams` People were individual today. The  number of people individual overall is now `r n_individual` and we are `r left` away from the target (12,217). 

There were `r n_le_today` diagnoses of LF lymphedema through the HH survey on `r max(individual$date)`, bringing the total number detected since 18/03 to `r n_le_found`.  

There were `r n_hc_today` diagnoses of LF hydrocele through the HH survey on `r max(individual$date)`, bringing the total number detected since 18/03 to `r n_hc_found`.  

Number of confirmed and excluded individual of LF lymphedema and hydrocele, out of all suspected individual, by village (HH survey):  

- *Form versions in use*

There was/ were `r n_defs` Household (HH) form version(s) in use on `r max(hh$date)`  

```{r}
formdefs %>%
  kbl() %>%
  kable_classic_2(full_width = F)
```
Phones not recording electronic signatures

There were `r nrow(individual[individual$exam_consent==1 & !is.na(individual$exam_consent),])` casses of signatures not working

```{r}
# make a table showing the form version and number of complete screens 
nosignames <- individual[individual$exam_consent==1 & !is.na(individual$exam_consent) , c("HH_implementer_id", "date") ]
nosignames %>%
  kbl() %>%
  kable_classic_2(full_width = F)

```

***

```{r, include = FALSE}

# check number of interviews, screens, suspect cases by implementer
n_interviews_implementer <- hh %>% group_by(HH_implementer_id) %>% summarise(total_submissions = n(),  complete_interviews = sum(survey_complete))

n_examined_ind <- individual %>% group_by(HH_implementer_id) %>% summarise(individual = n(), le_suspect = sum(lymphoedema==1, na.rm = TRUE),  hc_suspected = sum(scrotum_swelling==1, na.rm = TRUE))

summary_interview_examined <- as.data.frame(left_join(n_interviews_implementer, n_examined_ind, by =c("HH_implementer_id")))

summary_interview_examined <- summary_interview_examined[with(summary_interview_examined, order(-complete_interviews)), ]
```


### People censused and examined by team and implementer


```{r, results='asis'}

kable(summary_interview_examined, "html") %>%
  kable_styling(bootstrap_options = c("striped", "hover"))

```

***


```{r, include = FALSE}

cluster_polygons_raw <- st_read("anonymous_data/clusters_raw.shp")

nrow(cluster_polygons_raw)
# filter by date to reduce dataset for the demo
cluster_polygons_raw <- cluster_polygons_raw %>%
  filter(date >= as.Date("2021-04-01") & 
         date < as.Date("2021-04-30"))


cluster_polygons_clean <- st_read("anonymous_data/clusters_cleaned.shp")
cluster_polygons_clean <- cluster_polygons_clean %>%
  filter(date >= as.Date("2021-04-01") & 
         date < as.Date("2021-04-30"))


```



### Map 1: Clusters visited most recent survey day

```{r}

paste("Date : ", max(cluster_polygons_raw$date) ) 

mapview(cluster_polygons_raw[cluster_polygons_raw$date==max(cluster_polygons_raw$date),], map.types = c("Esri.WorldImagery"), 
        color = "black", lwd = 2) 
```
- *Map 1: CHW polygons 1*

This shows clusters mapped on the most recent survey day 
check clusters are not overlapping 
(HH locations not shown on this map for confidentiality)
Check HH locations are within geotraces


***


### Map 2: All Clusters visited

```{r}
mapview(cluster_polygons_clean, map.types = c("Esri.WorldImagery"), 
        color = "black", lwd = 2) 
```



```{r, include = FALSE}

## data for chart 1 : Number of completed questionnaires for the most recent day, including hh_outcome
enumerators <- hh %>% 
  filter(((date == max(hh$date) )  )) %>% 
  group_by(HH_implementer_id, hh_outcome) %>% 
  summarise(n_hhs = n())

enumerators <- enumerators[with(enumerators, order(-n_hhs)), ]
```


###  Questionnaires by Implementer (most recent workday only)

```{r}
enumerators_n_outcome  <-  ggplot(data=enumerators, aes(x=HH_implementer_id, y=n_hhs, fill=hh_outcome)) + 
  guides(size = FALSE) +
  scale_color_viridis_d(guide = "none") +
  geom_bar(stat="identity", position="stack" ) +  
  labs(title="",
       x ="", y = "Number of Households") +
  theme_bw() + theme(legend.title=element_blank(), 
                     legend.position="none",  
                     axis.title.x=element_blank(),  
                     axis.title.y=element_text(),  
                     panel.background=element_blank(), 
                     panel.grid.minor=element_blank(), 
                     panel.grid.major=element_blank()) + 
scale_fill_manual("legend", values = c("HH complete" = "chartreuse4", "Control HH" = "yellow", "Not HH" = "antiquewhite", "Nobody home" = "antiquewhite3", "Suspect case(s)" = "cornflowerblue", "No adult home" = "antiquewhite4", "Vacant" = "burlywood4", "No verbal consent"="gray1"))

ggplotly(enumerators_n_outcome)

```

***

```{r}
# dummy plot for legend showing outcome only
legend <- as.data.frame(unique(enumerators$hh_outcome))
colnames(legend) <- "hh_outcome"
legend$n <- 1

ggplot(data=legend, aes(x=hh_outcome, y=n, fill=hh_outcome  )) +   
  theme_bw() + theme(legend.title=element_blank(), 
                     legend.position="none",  
                     axis.title.y=element_blank(),  
                     axis.text.x=element_blank(),
                     axis.ticks.x=element_blank(),
                     axis.title.x=element_blank(),  
                     panel.background=element_blank(), 
                     panel.grid.minor=element_blank(), 
                     panel.grid.major=element_blank()) + 
  geom_bar(stat="identity") + 
scale_fill_manual("legend", values = c("HH complete" = "chartreuse4", "Control HH" = "yellow", "Not HH" = "antiquewhite", "Nobody home" = "antiquewhite3", "Suspect case(s)" = "cornflowerblue", "No adult home" = "antiquewhite4", "Vacant" = "burlywood4", "No verbal consent"="gray1")) + coord_flip()
 
```


***


- *Chart 1: Total number of questionnaires completed by type of questionnaire (outcome)*
Check implementers recording 0 houses empty or vacant


```{r, include = FALSE}
## data for chart 2 :Start and finish times

# format data for Chart 2-  start and end times
survey_times <- hh %>% 
  arrange(starttime) %>%
  group_by(date,  HH_implementer_id) %>% 
  summarise(first = min(starttime), last = max(endtime))

lims <- as.POSIXct(strptime(c("06:00", "20:00"), format = "%H:%M"))    

times <- hh[,c("date", "HH_implementer_id", "village_id", "starttime", "endtime", "survey_complete")]

times <- times %>% 
  arrange(starttime) %>%
  group_by(date, HH_implementer_id) %>% 
  summarise(first = min(starttime), last = max(endtime), complete = sum(survey_complete==1, na.rm = TRUE))


```


### Start/ Finish times

```{r}

# Chart 2-  start and end times
times$first <-  format(as.POSIXct(times$first, format = "%Y-%m-%d %H:%M:%S"),  "%H:%M")
times$last <-  format(as.POSIXct(times$last, format = "%Y-%m-%d %H:%M:%S"),  "%H:%M")

times$first  <- as.POSIXct(times$first , format="%H:%M")
times$last  <- as.POSIXct(times$last, format="%H:%M")


times$date <- ymd(times$date)

gg_time <- ggplot(data = times, aes(x = date, y = first)) +
  geom_jitter(aes(fill = HH_implementer_id), width = 0.1, size = 3, alpha = 0.7) +
  geom_jitter(aes(y = last, fill = HH_implementer_id), pch =24,  width = 0.1, size = 3.5, alpha = 0.7) +
  ylab("Time of submission") + 
  xlab("Date") +
  theme(legend.position = "none") +
  ggtitle("Daily start and finish time by enumerator") + scale_y_datetime(limits = lims,
                                                                          breaks = "2 hour",
                                                                          date_labels= "%H:%M") 


ggplotly(gg_time)



```

***

- *Chart 2-  start and end times*

Check implementers starting after 10 or starting last interview before 4pm


```{r, include = FALSE}
## data for chart 3 : Duration of interviews
survey_duration <- hh[!is.na(hh$age_hoh),] %>% 
  arrange(starttime) %>%
  group_by( HH_implementer_id, hh_outcome) %>% 
  summarise(mean_dur = mean(duration))
```


### Duration

```{r}
duration_outcome <- ggplot(survey_duration, aes(HH_implementer_id, mean_dur)) +   
  geom_bar(aes(fill = hh_outcome), position = "dodge", stat="identity")  + 
  theme_bw() + theme(axis.title.x=element_blank(),
                     axis.text.x=element_blank(),
                     axis.ticks.x=element_blank(),
                     legend.position="none") +
                    labs(title="",
                     x ="", y = "Duration (minutes)") 

ggplotly(duration_outcome)


```


***

- *Chart 3-  duration by survey type*

Duration of survey by questionnaire type (all questionnaires)
Check if any implementers seem to be rushing interviews/ examinations


```{r, include = FALSE}
## data for chart 4& 5 : Examination refusals

# define refusal indicator for lymph and scrotum
individual$lymph_refuse <- 0
individual[!is.na(individual$lymph_exam) & individual$lymph_exam==0,]$lymph_refuse <- 1

individual$scrotum_refuse <- 0
individual[!is.na(individual$scrotum_exam) & individual$scrotum_exam==0,]$scrotum_refuse <- 1


refusals <- individual %>% 
  group_by( HH_implementer_id) %>% 
  summarise(total = n(),  
            n_lymph_exam = sum(lymph_exam==1, na.rm = TRUE),
            n_lymph_refuse = sum(lymph_refuse==1, na.rm = TRUE),
            n_scrotum_exam = sum(!is.na(scrotum_exam) & scrotum_exam==1, na.rm = TRUE),
            n_scrotum_refuse = sum(scrotum_refuse==1, na.rm = TRUE))

```


### Refusals- Lymphedema

```{r}
le_refusals_plot <- plot_ly(data=refusals, x = ~HH_implementer_id, y = ~n_lymph_exam, type = 'bar', name = 'Examined for lymphedema') %>%
  add_trace(y = ~n_lymph_refuse, name = 'Refused limb exam') %>%
  layout(yaxis = list(title = 'Count'), barmode = 'stack', xaxis = list(
    title = 'Implementer')) 

le_refusals_plot

```
***
- *Chart 6-  number of people refusing examination of limbs  (all questionnaires)*


### Refusals- Hydrocele

```{r}

hy_refusals_plot <- plot_ly(data=refusals, x = ~HH_implementer_id, y = ~n_scrotum_exam, type = 'bar', name = 'Examined for hydrocele') %>%
  add_trace(y = ~n_scrotum_refuse, name = 'Refused scrotum exam') %>%
  layout(yaxis = list(title = 'Count'), barmode = 'stack', xaxis = list(
    title = 'Implementer'))  

hy_refusals_plot

```
***
- *Chart 7-  number of people refusing scrotum examination  (all questionnaires) *